home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Hardcore Visual Basic 5.0 (2nd Edition)
/
Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso
/
Code
/
Goodies
/
NEWINT~1
/
TRACBA~1
/
FRMTRA~1.FRM
next >
Wrap
Text File
|
1997-06-04
|
4KB
|
146 lines
VERSION 5.00
Begin VB.Form Form1
Caption = "TracBar (Slider Control)"
ClientHeight = 4410
ClientLeft = 4635
ClientTop = 3300
ClientWidth = 5655
LinkTopic = "Form1"
ScaleHeight = 4410
ScaleWidth = 5655
StartUpPosition = 2 'CenterScreen
Begin VB.TextBox Text3
Height = 285
Left = 3780
TabIndex = 4
Text = "1"
Top = 2205
Width = 810
End
Begin VB.TextBox Text2
Height = 285
Left = 1050
TabIndex = 2
Text = "1"
Top = 3615
Width = 810
End
Begin VB.TextBox Text1
Height = 285
Left = 4200
TabIndex = 1
Text = "1"
Top = 1170
Width = 810
End
Begin VB.CommandButton Command1
Caption = "Set Slider position to ---->"
Height = 405
Left = 1515
TabIndex = 0
Top = 2130
Width = 2070
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = $"frmTracBar.frx":0000
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 810
Left = 165
TabIndex = 3
Top = 150
Width = 5430
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim SliderH As New CTracBar32
Dim SliderV As New CTracBar32
Private Const WM_PAINT = &HF
Private Const WM_VSCROLL = &H115
Private Const WM_HSCROLL = &H114
Private Sub Command1_Click()
SliderH.SetTracBarPos CInt(Text3)
SliderV.SetTracBarPos CInt(Text3)
Text1 = SliderH.GetTracBarPos
Text2 = SliderV.GetTracBarPos
End Sub
Private Sub Form_Load()
With SliderH
Set .Parent = Me
.Create 70, 70, 200, 35
End With
With SliderV
Set .Parent = Me
.Create 20, 70, 35, 200, True
End With
'Subclass form to receive messages
SubClass Me.hwnd
Me.Show
Text3.SetFocus
End Sub
Public Sub ProcMsg(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long, result As Long)
On Error Resume Next
Select Case uMsg
Case WM_HSCROLL
'the window being scrolled is the slider we created then
'Get the position
If lParam = SliderH.GetTracBarHwnd Then
Text1 = SliderH.GetTracBarPos
End If
Case WM_VSCROLL
If lParam = SliderV.GetTracBarHwnd Then
Text2 = SliderV.GetTracBarPos
End If
End Select
End Sub
Private Sub SubClass(hwnd As Long)
On Error Resume Next
NextProcs = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub UnSubClass()
Dim hWndCur As Long
hWndCur = Me.hwnd
If NextProcs Then
SetWindowLong hWndCur, GWL_WNDPROC, NextProcs
NextProcs = 0
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
UnSubClass
End Sub
Private Sub Text3_KeyPress(KeyAscii As Integer)
If KeyAscii < 49 Or KeyAscii > 57 Then
KeyAscii = 0
Exit Sub
End If
End Sub